CICA 1993 April/CICA MS Windows - April 1993.iso/unzipped/programr/bcpp/cmmdlg/prn31_.pas

Pascal/Delphi Source File | 1992-09-07 | 17KB | 785 lines

{$IFDEF WINDOWS}

{µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}
{   \\\                                    }
{  -(j)-                                   }
{    /juanca                               }
{    ~                                     }
{$D ⌐ ACASA 1989-1992, All rights reserved }
{µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}

{a tPrinter object, that knows about tUsrWin windows, and how to tell them to print }
{ also uses CommonDlgs for Print, and PrinterSetup }

{$ENDIF}
UNIT PRN31_;
{$C MOVEABLE DEMANDLOAD DISCARDABLE}
INTERFACE
   USES
     WINTYPES,
     WIN31,
     WOBJECTS,
     COMMDLG,
     PORT_,
     USRWIN_,
     PRINTDLG;

   { TPrintout banding flags }
   CONST
     pf_Graphics  = $01;        { Current band only accepts text }
     pf_Text      = $02;        { Current band only accepts graphics }
     pf_Both      = $03;        { Current band accepts both text and
                               graphics }
   TYPE
      pAbortProc = ^TAbortProc;

      tBandInfoStruct = RECORD
        fGraphicsFlag: Bool;
        fTextFlag: Bool;
        GraphcisRect: TRect;
      END;


  TYPE
    PAbortPrintDlg = ^TAbortPrintDlg;
    TAbortPrintDlg = OBJECT (tDlgWindow)
      CONSTRUCTOR
        init(iparent:PWindowsObject; name :pChar; msg:pChar);

      DESTRUCTOR
        done;
          virtual;
      PROCEDURE
        setupWindow;
          virtual;
      PROCEDURE
        wmCommand(var msg:TMessage);
          virtual
            wm_First+wm_Command;

      PROCEDURE
      destroy;
        virtual;

      PROCEDURE
      wmDestroy(var msg :tMessage);
        virtual
          wm_First+wm_Destroy;
    PRIVATE
      _msg :array[0..200] of Char;
    END;


   TYPE
     Super      = TPort;
     PPrinter = ^TPrinter;
     TPrinter = OBJECT (Super)

       printerData :tPrintDlg;


       CONSTRUCTOR
         init;
       DESTRUCTOR
         done;
           virtual;

       FUNCTION
         context:THandle;
           virtual;

       FUNCTION
       isPrinter :Boolean;
         virtual;

       FUNCTION
       cycle:Boolean;
         virtual;

       FUNCTION
       printFlags :Longint;
         virtual;

       FUNCTION
       setupTemplate :pChar;
         virtual;

       FUNCTION
       optionsTemplate :pChar;
         virtual;

       FUNCTION
       abortTemplate :pChar;
         virtual;

       FUNCTION
       makeOptionsDlg(wnd :pWindowsObject; data:pPrintDlg) :pPrintOptDlg;
         virtual;

       FUNCTION
       makeSetupDlg(wnd :pWindowsObject; data:pPrintDlg) :pPrintSetupDlg;
         virtual;

       FUNCTION
       makeAbortDlg(wnd :pWindowsObject; msg :pChar) :pAbortPrintDlg;
         virtual;

       PROCEDURE
       getDevNames(devNames :pDevNames; var driver, device, output :pChar);

       FUNCTION
         errors:Boolean;
       FUNCTION
         aborted:Boolean;
       FUNCTION
         errorNo:Integer;

       FUNCTION
       calcBandingFlags(var band :tRect; firstBand :Boolean) :Word;


       FUNCTION
       print(awin: pUsrWin; docName :pChar): Boolean;
         virtual;

       PROCEDURE
         startDoc(win:PWindowsObject; docName:pChar);
       PROCEDURE
         endDoc;
       PROCEDURE
         abortDoc;

       FUNCTION
         nextBand(var box:tRect) :Boolean;

       PROCEDURE
         startPage;
       PROCEDURE
         endPage;

       PROCEDURE
         setAbortProc(proc :tAbortProc);

       PROCEDURE
         getPageSize(var dim:tPoint);

       PROCEDURE
         printingOffset(var off :tPoint);


       FUNCTION
       banding :Boolean;

       FUNCTION
       options(wnd :pUsrWin):Boolean;

       PROCEDURE
       setup(wnd :pWindowsObject);

     PRIVATE
       _errorNo     :Integer;
       _abortProc   :tFarProc;
       _banding,
       _useBandInfo :Boolean;
     END;{OBJECT TDevice}



IMPLEMENTATION
  USES
    WINPROCS,
    STRINGS;

  CONST
    userAbort    :Boolean = TRUE;
    printErrors  :Boolean = FALSE;
    abortDlg     :pWindowsObject = nil;
    id_Msg                = 100;


  FUNCTION
  {}
  printingAbort(hdc :THandle; code :Integer) :Boolean;
  export;
      var
        msg :TMsg;
      begin
        printErrors := printErrors or (code <> 0);
        while not (userAbort or printErrors)
        and peekMessage(msg, 0, 0, 0, pm_Remove)
        do
          if not application^.processAppMsg(msg)
          then begin
            TranslateMessage(Msg);
            DispatchMessage(Msg);
          end;
        printingAbort := not (userAbort or printErrors)
      end;

   CONSTRUCTOR
   TAbortPrintDlg.
     {}
   init(iparent:PWindowsObject; name :pChar; msg:pChar);
     begin
       tDlgWindow.init(iparent, name);
       strCopy(_msg, msg);
     end;


   PROCEDURE
   TAbortPrintDlg.
     {}
   setupWindow;
     begin
       abortDlg := @self;
       tDlgWindow.setupWindow;
       setDlgItemText(hwindow, id_Msg, _msg);

       enableWindow(application^.mainWindow^.hwindow, FALSE);
       show(sw_Normal);
       setFocus(hwindow);
       updateWindow(hwindow);
     end;

   DESTRUCTOR
   TAbortPrintDlg.
     {}
   done;
     begin
       abortDlg := nil;
       tDlgWindow.done
     end;


   PROCEDURE
   TAbortPrintDlg.
     {}
   wmCommand(var msg:TMessage);
     begin
       tDlgWindow.wmCommand(msg);
       userAbort    := TRUE;
     end;


   PROCEDURE
   TAbortPrintDlg.
     {}
   destroy;
     begin
       with application^.mainWindow^
       do begin
         enableWindow(hwindow, TRUE);
         setFocus(hwindow);
       end;
       tDlgWindow.destroy;
     end;


   PROCEDURE
   TAbortPrintDlg.
     {}
   wmDestroy(var msg :tMessage);
     begin
       with application^.mainWindow^
       do begin
         enableWindow(hwindow, TRUE);
         setFocus(hwindow);
       end;
       tDlgWindow.wmDestroy(msg)
     end;


   CONSTRUCTOR
   TPrinter.
     {}
   init;
     var
       esc :Integer;
     begin
       if not Super.init
       then
         fail;
       _errorNo   := 1;
       _abortProc := nil;
       userAbort   := FALSE;
       fillChar(printerData, sizeOf(printerData), 0);
       with printerData
       do begin
         lStructSize   := sizeof(printerData);
         hInstance     := SYSTEM.HInstance;
         flags         := pd_ReturnDC or pd_ReturnDefault;
         nMinPage      := 0;
         nMaxPage      := 0;
       end;

       if not COMMDLG.printDlg(printerData)
       then
         fail;

       printerData.flags := printFlags;


       setAbortProc(printingAbort);
       _banding := (getDeviceCaps(context, RasterCaps) and rc_Banding) <> 0;
       esc := WINTYPES.BANDINFO;
       _useBandInfo := escape(context, queryEscSupport, sizeOf(esc), @esc, nil) <> 0;
     end;

   DESTRUCTOR
   TPrinter.
     {}
   done;
     begin
       if abortDlg <> nil
       then begin
          dispose(abortDlg, done);
          abortDlg := nil
       end;
       with printerData
       do begin
         deleteDC(context);
         globalFree(hDevMode);
         globalFree(hDevNames)
       end;
       Super.done
     end;

   FUNCTION
   TPrinter.
     {}
   context:THandle;
     begin
       context := printerData.hDC
     end;

   FUNCTION
   tPrinter.
   {}
   printFlags :Longint;
     begin
       printFlags :=    pd_ReturnDC or
                        pd_UseDevModeCopies or
                        pd_NoSelection or
                        pd_NoPageNums or
                        pd_NoWarning
     end;

   PROCEDURE
   TPrinter.
     {}
   getDevNames(devNames :pDevNames; var driver, device, output :pChar);
     var
       str :pChar absolute devNames;
     begin
       with devNames^
       do begin
         driver := str+wDriverOffset;
         device := str+wDeviceOffset;
         output := str+wOutputOffset;
       end
     end;

   FUNCTION
   TPrinter.
     {}
   errors:Boolean;
     begin
       errors := (_errorNo <= 0) or printErrors
     end;

   FUNCTION
   TPrinter.
     {}
   aborted:Boolean;
     begin
       aborted := userAbort
     end;

   FUNCTION
   TPrinter.
     {}
   errorNo :Integer;
     begin
       errorNo := _errorNo
     end;

   PROCEDURE
   TPrinter.
     {}
   startDoc(win:PWindowsObject; docName:pChar);
     var
       winDC  :PPort;
       abdlg  :PAbortPrintDlg;
       msg    :array[0..300] of Char;
       devName,
       driver,
       outp   :pChar;

       info   :TDocInfo;

     begin
       with printerData
       do begin
         getDevNames(globalLock(hDevNames), driver, devName, outp);
         globalUnlock(hDevNames)
       end;
       strPCopy(msg, 'Printing'#10+
                     strPas(docName)+#10+
                     'on'#10+
                     strPas(devName)+#10+
                     'connected to'+#10+
                     strPas(outp)
                     );
       if not errors
       then begin
         abortDlg := application^.makeWindow(makeAbortDlg(win, msg));
         if abortDlg = nil
         then
           exit
       end;
       userAbort   := FALSE;
       printErrors := FALSE;

       with info
       do begin
         cbSize := sizeOf(info);
         lpszDocName := docName;
         lpszOutput   := nil
       end;
       _errorNo := WIN31.setAbortProc(context, tAbortProc(_abortProc));
       if not errors
       then
         _errorNo := WIN31.startDoc(context, info)
     end;

   PROCEDURE
   TPrinter.
     {}
   endDoc;
     begin
       if not errors
       and not aborted
       then
         _errorNo := WIN31.endDoc(context)
       else
         abortDoc;
       if abortDlg <> nil
       then begin
          dispose(abortDlg, done);
          abortDlg := nil
       end
     end;

   PROCEDURE
   TPrinter.
     {}
   abortDoc;
     begin
       userAbort := TRUE;
       _errorNo := WIN31.abortDoc(context);
       if abortDlg <> nil
       then begin
          dispose(abortDlg, done);
          abortDlg := nil
       end;
     end;

   FUNCTION
   TPrinter.
     {}
   nextBand(var box:tRect) :Boolean;
     begin
       if banding then
         _errorNo := escape(context, WinTypes.NEXTBAND, 0, nil, @box)
       else
         _errorNo := escape(context, WinTypes.GetPhysPageSize, 0, nil, @box);
       nextBand := not isRectEmpty(box) and not errors and not userAbort
     end;

   PROCEDURE
   TPrinter.
     {}
   getPageSize(var dim:tPoint);
     begin
       _errorNo := escape(context, WinTypes.GetPhysPageSize, 0, nil, @dim);
     end;

   PROCEDURE
   TPrinter.
     {}
   printingOffset(var off :tPoint);
     begin
       _errorNo := escape(context, WinTypes.GetPrintingOffset, 0, nil, @off);
     end;


   PROCEDURE
   TPrinter.
     {}
   startPage;
     begin
       _errorNo := WIN31.startPage(context)
     end;

   PROCEDURE
   TPrinter.
     {}
   endPage;
     begin
       {_errorNo := }WIN31.endPage(context)
     end;

   PROCEDURE
   TPrinter.
     {}
   setAbortProc(proc :tAbortProc);
     begin
       _abortProc := makeProcInstance(@proc, hinstance);
       WIN31.setAbortProc(context, tAbortProc(_abortProc))
     end;

   FUNCTION
   tPrinter.
   {}
   isPrinter :Boolean;
     begin
       isPrinter := TRUE
     end;

   FUNCTION
   TPrinter.
     {}
   cycle:Boolean;
     begin
         cycle := tAbortProc(_abortProc)(context, 0) and not errors;
     end;

   FUNCTION
   TPrinter.
     {}
   banding :Boolean;
     begin
       banding := _banding
     end;

   FUNCTION
   tPrinter.
   {}
   setupTemplate :pChar;
     begin
       setupTemplate := nil
     end;

   FUNCTION
   tPrinter.
   {}
   optionsTemplate :pChar;
     begin
       optionsTemplate := nil
     end;

   FUNCTION
   tPrinter.
   {}
   abortTemplate :pChar;
     begin
       abortTemplate := 'PRINTING_DLG'
     end;

   FUNCTION
   tPrinter.
   {}
   makeOptionsDlg(wnd :pWindowsObject; data:pPrintDlg) :pPrintOptDlg;
     begin
      makeOptionsDlg :=  new( pPrintOptDlg, init(wnd, optionsTemplate, data, makeSetupDlg(wnd, data)));
     end;

   FUNCTION
   tPrinter.
   {}
   makeSetupDlg(wnd :pWindowsObject; data:pPrintDlg) :pPrintSetupDlg;
     begin
      makeSetupDlg :=  new( pPrintSetupDlg,init(wnd, setupTemplate, @printerData));
     end;

   FUNCTION
   tPrinter.
   {}
   makeAbortDlg(wnd :pWindowsObject; msg :pChar) :pAbortPrintDlg;
     begin
      makeAbortDlg :=  new( pAbortPrintDlg,init(wnd, abortTemplate, msg));
     end;

   FUNCTION
   TPrinter.
     {}
   options(wnd :pUsrWin):Boolean;
     begin
       with printerData
       do begin
         wnd^.getPrintRange(nMinPage, nMaxPage);
         flags := flags or wnd^.printFlags;
         if nMinPage <> nMaxPage
         then
           flags := flags and not pd_NoPageNums
       end;
       options := id_Ok =
       application^.execDialog(makeOptionsDlg(wnd, @printerData))
     end;


   PROCEDURE
   TPrinter.
     {}
   setup(wnd :pWindowsObject);
     begin
       with printerData
       do
         flags := flags or printFlags;
       application^.execDialog(makeSetupDlg(wnd, @printerData))
     end;

   FUNCTION
   tPrinter.
   {}
   calcBandingFlags(var band :tRect; firstBand :Boolean) :Word;
     var
       BandInfoRec  :TBandInfoStruct;
       pFlags       :Word;
       flags        :Word;
       pageSize     :tPoint;
     begin
       { Calculate text verses graphics banding }
       if _useBandInfo
       then begin
         escape(context, bandInfo, sizeOf(tBandInfoStruct), nil, @BandInfoRec);
         if bandInfoRec.fGraphicsFlag
         then
           pFlags := pf_Graphics;
     (*    if BandInfoRec.fTextFlag then pFlags := pf_Text; *)
         if BandInfoRec.fTextFlag
         then pFlags := pFlags or pf_Text;
         flags := (flags and not pf_Both) or pFlags;
       end
       else begin
         { If a driver does not support BandInfo the Microsoft
           Recommended way of determining text only bands is if
           the first band is the full page, all others are
           graphcis only.  Otherwise it handles both. }
         getPageSize(pageSize);
         if firstBand
  {           and (LongInt((@band.left)^) = 0)  %% dunno what this is for}
         and (band.right = PageSize.X)
         and (band.bottom = PageSize.Y)
         then
           flags := pf_Text
         else if Flags
         and pf_Both = pf_Text
         then
           { All other bands are graphics only }
           flags := (Flags and not pf_Both) or pf_Graphics
         else
           flags := flags or pf_Both;
       end;

       calcBandingFlags := flags
     end;

   FUNCTION
   TPrinter.
   {}
   print(awin: pUsrWin; docName :pChar): Boolean;
     var
       PageSize      :tPoint;
       band          :tRect;
       firstBand     :Boolean;
       flags         :Word;
       pageNumber    :Word;

     begin
        if not options(aWin)
        then begin
          print := TRUE;
          exit
        end;

        print := False; { Assume error occured }

       _errorNo := 0;

       if aWin = nil
       then
         exit;

       if context = 0
       then
         exit;

       { Get the page size }
       getPageSize(pageSize);

       if not banding
       then
         with pageSize
         do
           setRect(band, 0, 0, x, y)
       else begin
         { Only use BandInfo if supported (note: using Flags as a temporary) }
         flags := bandInfo;
       end;

       flags := pf_Both;

       startDoc(aWin, docName);

       pageNumber := printerData.nMinPage;
       if not errors
       then begin
         repeat
           startPage;
           if banding
           then begin
             firstBand := TRUE;
             nextBand(band)
           end;
           repeat
             { Call the abort proc between bands or pages }
             cycle;

             if banding
             then begin
               flags := calcBandingFlags(band, firstBand);
               if {(Printout^.ForceAllBands)} FALSE and (Flags and pf_Both = pf_Text)
               then
                 setPixel(0, 0, 0);
             end;

             if not errors
             then
               aWin^.printPage(@self, pageNumber, pageSize, band, flags);
             firstBand := FALSE
           until
              errors or
              not banding
              or not nextBand(band);

           { NewFrame should only be called if not banding }
           if not errors
           then
             endPage;

           inc(pageNumber);
         until
           errors    or
           userAbort or
           (pageNumber > printerData.nMaxPage);

         { Tell GDI the document is finished }
         endDoc
       end;

       print := not errors
     end;


END.